home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / misc / volume18 / oraperl / part01 next >
Encoding:
Internet Message Format  |  1991-04-11  |  47.7 KB
  1. From: kstock@isfrance.encore.fr (Kevin Stock)
  2. Newsgroups: comp.sources.misc
  3. Subject: v18i010:  oraperl - Extensions to Perl to access Oracle databases, Part01/01
  4. Message-ID: <1991Apr10.205602.17485@sparky.IMD.Sterling.COM>
  5. Date: 10 Apr 91 20:56:02 GMT
  6. Approved: kent@sparky.imd.sterling.com
  7. X-Checksum-Snefru: b370bee3 db8dd5ba 7b4f5b7b 98c29752
  8.  
  9. Submitted-by: Kevin Stock <kstock@gouldfr.encore.fr>
  10. Posting-number: Volume 18, Issue 10
  11. Archive-name: oraperl/part01
  12.  
  13. The attached shar contains ORAPERL, a set of usersubs for Perl allowing
  14. it to access Oracle databases. It requires a version of Perl capable of
  15. accepting usersubs (3.0.27 or later) and the Oracle Pro*C product. It
  16. has been tested on an Encore Multimax running UMAX V (Sys Vr3.2) and
  17. compiled (but not tested, since I don't have Pro*C on that machine) in
  18. the BSD universe of a Gould PN 6040.
  19.  
  20. Read README and modify Makefile (and oracle.mus if necessary). Then
  21. type  make  and let it go.
  22.  
  23. I wrote this in order to allow me to get information out of an Oracle
  24. database into a Perl program, but since any SQL statement may be used,
  25. it is also possible for the Perl program to modify data. I don't think
  26. that there's any risk attached to this, but I haven't used it extensively.
  27.  
  28. Any comments, bug reports (and fixes) gratefully accepted. If you find this
  29. useful, please let me know what you're using it for - it's good for my ego!
  30.  
  31.     Kevin.
  32. ----
  33. #!/bin/sh
  34. # This is a shell archive (shar 3.47)
  35. # made 04/10/1991 08:14 UTC by kstock@isfrance
  36. # Source directory /wp/users/kstock/tmp
  37. #
  38. # existing files will NOT be overwritten unless -c is specified
  39. #
  40. # This shar contains:
  41. # length  mode       name
  42. # ------ ---------- ------------------------------------------
  43. #   2175 -rw-r--r-- README
  44. #   1347 -rw-r--r-- Makefile
  45. #    112 -rwxr-xr-x debug-p
  46. #    655 -rw-r--r-- ex.pl
  47. #   5749 -rw-r--r-- getcursor.c
  48. #   3876 -rw-r--r-- oracle.mus
  49. #   8596 -rw-r--r-- orafns.c
  50. #   3578 -rw-r--r-- orafns.h
  51. #   4711 -rw-r--r-- oraperl.1
  52. #   7198 -rw-r--r-- oraperl.doc
  53. #   1401 -rw-r--r-- oraperl.ref
  54. #    499 -rw-r--r-- usersub.c
  55. #
  56. # ============= README ==============
  57. if test -f 'README' -a X"$1" != X"-c"; then
  58.     echo 'x - skipping README (File already exists)'
  59. else
  60. echo 'x - extracting README (Text)'
  61. sed 's/^X//' << 'SHAR_EOF' > 'README' &&
  62. XThis is an instant-mix package (just add Perl) to create Oraperl,
  63. Xa version of Perl which is capable of accessing Oracle databases.
  64. XTo use it, you must have the Oracle Pro*C product and a version of
  65. XPerl which supports Usersubs (v3.0.27 or later).
  66. X
  67. XUnshar it somewhere convenient, and edit the Makefile. You may need
  68. Xto change the definitions below:
  69. X
  70. X    ORACLE_HOME    your Oracle installation directory
  71. X    SRC        your Perl source directory (with the usub directory)
  72. X    OTHERLIBS    \
  73. X    CLIBS         |
  74. X    OCILIB         +- copy these from your proc.mk file
  75. X    NETLIBS         |
  76. X    ORALIBS        /
  77. X    GLOBINCS    \
  78. X    LOCINCS         +- copy these from $SRC/usub/Makefile
  79. X    LIBS        /
  80. X    DEBUG        -DDEBUGGING, -DPERL_DEBUGGING or leave blank;
  81. X            see orafns.h for an explanation
  82. X
  83. XIf your version of Perl is earlier than v4, you will also need to make
  84. Xone change to  oracle.mus . The name  str_2mortal()  on line 100 must
  85. Xbe changed to  str_2static()  with the same arguments.
  86. X
  87. XI've only tested this on an Encore Multimax 520 running UMAX V (Sys Vr3.2),
  88. Xusing Perl 3.0.34 and 4.0.00 with Oracle version 6, as I don't have access
  89. Xto any other system with Pro*C. I'd appreciate any comments, bug-reports etc.
  90. X
  91. XIn addition to this README, the package contains the following files:
  92. X
  93. XSource Code:
  94. X    Makefile    building instructions
  95. X    orafns.h    common declarations
  96. X    oracle.mus    function interface description
  97. X    getcursor.c    functions to deal with the cursor pool
  98. X    orafns.c    actual functions to interact with oracle
  99. X    usersub.c    initialisation routine
  100. X
  101. XExamples (taken from the manual page)
  102. X    debug-p        tests to see if debugging is available
  103. X    ex.pl        simple example of using the functions
  104. X
  105. XDocumentation
  106. X    oraperl.doc    explains some of the thinking behind Oraperl
  107. X    oraperl.ref    quick reference (troff format)
  108. X    oraperl.1    manual page
  109. X
  110. XMany thanks to Larry for Perl. Now if only we could get the Camel book
  111. Xinto France! Hmm. Any plans for "Le Livre Chameau"?
  112. X
  113. X    Kevin Stock
  114. X    kstock@gouldfr.encore.fr
  115. X
  116. X
  117. X            NOTICE - Warranty and Copyright
  118. X
  119. XOraperl is not a product of Encore Computer Corporation or any of its
  120. Xsubsidiaries. There is no warranty, and no official support is available.
  121. X
  122. XIt is copyright, but may be freely distributed under the same terms as
  123. XPerl itself.
  124. SHAR_EOF
  125. chmod 0644 README ||
  126. echo 'restore of README failed'
  127. Wc_c="`wc -c < 'README'`"
  128. test 2175 -eq "$Wc_c" ||
  129.     echo 'README: original size 2175, current size' "$Wc_c"
  130. fi
  131. # ============= Makefile ==============
  132. if test -f 'Makefile' -a X"$1" != X"-c"; then
  133.     echo 'x - skipping Makefile (File already exists)'
  134. else
  135. echo 'x - extracting Makefile (Text)'
  136. sed 's/^X//' << 'SHAR_EOF' > 'Makefile' &&
  137. X# Makefile for Oraperl
  138. X
  139. X# Change these to your ORACLE installation directory and Perl source directory
  140. X
  141. XORACLE_HOME    = /usr/soft/oracle
  142. XSRC        = /usr/soft/public/perl4/src
  143. X
  144. X# Oracle Definitions, taken from proc.mk
  145. X
  146. XOTHERLIBS    = `cat $(ORACLE_HOME)/rdbms/lib/sysliblist`
  147. XCLIBS        = $(OTHERLIBS)
  148. XOCILIB        = $(ORACLE_HOME)/rdbms/lib/libocic.a
  149. XNETLIBS        = $(ORACLE_HOME)/rdbms/lib/osntab.o \
  150. X            $(ORACLE_HOME)/rdbms/lib/libsqlnet.a 
  151. XORALIBS        = $(ORACLE_HOME)/rdbms/lib/libora.a
  152. X
  153. X# Perl Definitions, taken from $SRC/usub/Makefile
  154. X
  155. XGLOBINCS    = 
  156. XLOCINCS        = 
  157. XLIBS        =
  158. X
  159. X# Oraperl Definitions
  160. X
  161. X# Set DEBUG to -DDEBUGGING, -DPERL_DEBUGGING or leave blank (see orafns.h)
  162. X
  163. XDEBUG        = -DPERL_DEBUGGING
  164. XCFLAGS        = $(DEBUG) -I$(SRC) $(GLOBINCS) -O
  165. X
  166. Xoraperl: $(SRC)/uperl.o usersub.o oracle.o orafns.o getcursor.o
  167. X    cc -o oraperl $(SRC)/uperl.o usersub.o oracle.o orafns.o getcursor.o \
  168. X        -lm $(OCILIB) $(NETLIBS) $(ORALIBS) $(CLIBS)
  169. X
  170. Xoracle.c: $(SRC)/usub/mus oracle.mus
  171. X    chmod +x $(SRC)/usub/mus
  172. X    $(SRC)/usub/mus oracle.mus >oracle.c
  173. X
  174. Xusersub.o oracle.o orafns.o getcursor.o:    orafns.h
  175. X
  176. Xprint:    Makefile orafns.h orafns.c oracle.mus usersub.c getcursor.c
  177. X    pr -fn Makefile orafns.h getcursor.c orafns.c oracle.mus usersub.c | \
  178. X        pr -fto4 -e > Print
  179. X
  180. Xman: oraperl.1
  181. X    nroff -man oraperl.1 >oraperl.man
  182. X
  183. Xclean:
  184. X    rm -f nohup.out oraperl *.o oracle.c oraperl.man Print tags out core
  185. SHAR_EOF
  186. chmod 0644 Makefile ||
  187. echo 'restore of Makefile failed'
  188. Wc_c="`wc -c < 'Makefile'`"
  189. test 1347 -eq "$Wc_c" ||
  190.     echo 'Makefile: original size 1347, current size' "$Wc_c"
  191. fi
  192. # ============= debug-p ==============
  193. if test -f 'debug-p' -a X"$1" != X"-c"; then
  194.     echo 'x - skipping debug-p (File already exists)'
  195. else
  196. echo 'x - extracting debug-p (Text)'
  197. sed 's/^X//' << 'SHAR_EOF' > 'debug-p' &&
  198. Xdefined($ora_debug) && print "debugging available\n";
  199. Xdefined($ora_debug) || print "debugging not available\n";
  200. SHAR_EOF
  201. chmod 0755 debug-p ||
  202. echo 'restore of debug-p failed'
  203. Wc_c="`wc -c < 'debug-p'`"
  204. test 112 -eq "$Wc_c" ||
  205.     echo 'debug-p: original size 112, current size' "$Wc_c"
  206. fi
  207. # ============= ex.pl ==============
  208. if test -f 'ex.pl' -a X"$1" != X"-c"; then
  209.     echo 'x - skipping ex.pl (File already exists)'
  210. else
  211. echo 'x - extracting ex.pl (Text)'
  212. sed 's/^X//' << 'SHAR_EOF' > 'ex.pl' &&
  213. Xformat top =
  214. X       Name                           Phone
  215. X       ====                           =====
  216. X.
  217. X
  218. Xformat STDOUT =
  219. X       @<<<<<<<<<<              @>>>>>>>>>>
  220. X       $name,                   $phone
  221. X.
  222. X
  223. Xdie ("You should use oraperl, not perl\n") unless defined &ora_login;
  224. X
  225. X$lda = &ora_login("t", "kstock", "kstock")
  226. X    || die $ora_errstr;
  227. X$csr = &ora_open($lda, "select * from telno order by name")
  228. X    || die $ora_errstr;
  229. X
  230. X$nfields = &ora_fetch($csr);
  231. Xprint "Query will return $nfields fields\n\n";
  232. X
  233. Xwhile (($name, $phone) = &ora_fetch($csr))
  234. X{
  235. X    write;
  236. X}
  237. X
  238. Xdo ora_close($csr) || die "can't close cursor";
  239. Xdo ora_logoff($lda) || die "can't log off Oracle";
  240. SHAR_EOF
  241. chmod 0644 ex.pl ||
  242. echo 'restore of ex.pl failed'
  243. Wc_c="`wc -c < 'ex.pl'`"
  244. test 655 -eq "$Wc_c" ||
  245.     echo 'ex.pl: original size 655, current size' "$Wc_c"
  246. fi
  247. # ============= getcursor.c ==============
  248. if test -f 'getcursor.c' -a X"$1" != X"-c"; then
  249.     echo 'x - skipping getcursor.c (File already exists)'
  250. else
  251. echo 'x - extracting getcursor.c (Text)'
  252. sed 's/^X//' << 'SHAR_EOF' > 'getcursor.c' &&
  253. X/* getcursor.c
  254. X *
  255. X * Functions to deal with allocating and freeing cursors for Oracle
  256. X */
  257. X/* Copyright 1991 Kevin Stock.
  258. X *
  259. X * You may copy this under the terms of the GNU General Public License,
  260. X * a copy of which should have accompanied your Perl kit.
  261. X */
  262. X
  263. X#include    "EXTERN.h"
  264. X#include    <stdio.h>
  265. X#include    <ctype.h>
  266. X#include    "orafns.h"
  267. X
  268. X
  269. X/* head of the cursor list */
  270. Xstruct cursor csr_list = { NULL, NULL, NULL, 0, NULL };
  271. X
  272. X
  273. X/* ora_free_data(csr)
  274. X *
  275. X * Frees memory attached to csr->data
  276. X */
  277. X
  278. Xvoid ora_free_data(csr)
  279. Xstruct cursor *csr;
  280. X{
  281. X    int i;
  282. X
  283. X    DEBUG(8, (fprintf(stderr, "ora_free_data(%#lx)\n", (long) csr)));
  284. X
  285. X    if (csr->data == NULL)
  286. X    {
  287. X        DEBUG(8, (fputs("ora_free_data: returning\n", stderr)));
  288. X        return;
  289. X    }
  290. X
  291. X    for (i = 0 ; i < csr->nfields ; i++)
  292. X    {
  293. X        if (csr->data[i] != NULL)
  294. X        {
  295. X            DEBUG(128, (fprintf(stderr, "freeing (%d) == %#lx\n",
  296. X                i, (long) csr->data[i])));
  297. X            free(csr->data[i]);
  298. X        }
  299. X    }
  300. X
  301. X    DEBUG(128, (fprintf(stderr, "freeing %#lx\n", (long) csr->data)));
  302. X    free(csr->data);
  303. X    csr->data = NULL;
  304. X    csr->nfields = 0;
  305. X    DEBUG(8, (fputs("ora_free_data: returning\n", stderr)));
  306. X}
  307. X
  308. X
  309. X/* ora_getcursor()
  310. X *
  311. X * Allocates memory for a new cursor and returns its address.
  312. X * Inserts the cursor at the front of the list.
  313. X * Returns NULL if it can't get enough memory.
  314. X */
  315. X
  316. Xstruct cursor *ora_getcursor()
  317. X{
  318. X    struct cursor *tmp;
  319. X
  320. X    DEBUG(8, (fputs("ora_getcursor()\n", stderr)));
  321. X
  322. X    if ((tmp = (struct cursor *) malloc(sizeof(struct cursor))) == NULL)
  323. X    {
  324. X        DEBUG(128, (fputs("ora_getcursor: out of memory\n", stderr)));
  325. X        DEBUG(8, (fputs("ora_getcursor: returning NULL\n", stderr)));
  326. X        ora_errno = ORAP_NOMEM;
  327. X        return(NULL);
  328. X    }
  329. X    DEBUG(128, (fprintf(stderr,
  330. X        "ora_getcursor: got cursor at %#lx\n", (long) tmp)));
  331. X
  332. X    if ((tmp->csr = (struct csrdef *) malloc(sizeof(struct csrdef))) == NULL)
  333. X    {
  334. X        free(tmp);
  335. X        DEBUG(128, (fputs("ora_getcursor: out of memory\n", stderr)));
  336. X        DEBUG(8, (fputs("ora_getcursor: returning NULL\n", stderr)));
  337. X        ora_errno = ORAP_NOMEM;
  338. X        return(NULL);
  339. X    }
  340. X    DEBUG(128, (fprintf(stderr,
  341. X        "ora_getcursor: got csr at %#lx\n", tmp->csr)));
  342. X
  343. X    tmp->hda = NULL;
  344. X    tmp->data = NULL;
  345. X    tmp->nfields = 0;
  346. X    tmp->next = csr_list.next;
  347. X    csr_list.next = tmp;
  348. X
  349. X    ora_errno = 0;
  350. X    DEBUG(8, (fprintf(stderr,"ora_getcursor: returning %#lx\n",(long)tmp)));
  351. X    return(tmp);
  352. X}
  353. X
  354. X
  355. X/* ora_getlda()
  356. X *
  357. X * Gets a new login data area.
  358. X * Uses ora_getcursor and then allocates the host data area.
  359. X */
  360. X
  361. Xstruct cursor *ora_getlda()
  362. X{
  363. X    struct cursor *tmp;
  364. X
  365. X    DEBUG(8, (fputs("ora_getlda()\n", stderr)));
  366. X
  367. X    if ((tmp = ora_getcursor()) == NULL)
  368. X    {
  369. X        DEBUG(8, (fputs("ora_getlda: returning NULL\n", stderr)));
  370. X        return(NULL);
  371. X    }
  372. X
  373. X    if ((tmp->hda = malloc(256)) == NULL)
  374. X    {
  375. X        DEBUG(128, (fputs("ora_getlda: out of memory\n", stderr)));
  376. X        ora_dropcursor(tmp);
  377. X        DEBUG(8, (fputs("ora_getlda: returning NULL\n", stderr)));
  378. X        ora_errno = ORAP_NOMEM;
  379. X        return(NULL);
  380. X    }
  381. X    DEBUG(128, (fprintf(stderr,
  382. X        "ora_getlda: got hda at %#lx\n", tmp->hda)));
  383. X
  384. X    DEBUG(8, (fprintf(stderr, "ora_getlda: returning %#lx\n", tmp)));
  385. X    return(tmp);
  386. X}
  387. X
  388. X
  389. X/* ora_dropcursor(csr)
  390. X *
  391. X * Frees the space occupied by a given cursor, removing it from the list.
  392. X */
  393. X
  394. Xint ora_dropcursor(csr)
  395. Xstruct cursor *csr;
  396. X{
  397. X    struct cursor *tmp, *t;
  398. X
  399. X    tmp = &csr_list;
  400. X
  401. X    DEBUG(8, (fprintf(stderr, "ora_dropcursor(%#lx)\n", (long) csr)));
  402. X
  403. X    while ((tmp->next != NULL) && (tmp->next != csr))
  404. X    {
  405. X        tmp = tmp->next;
  406. X    }
  407. X
  408. X    if (tmp->next == NULL)
  409. X    {
  410. X        DEBUG(8, (fputs("ora_dropcursor: invalid\n", stderr)));
  411. X        ora_errno = ORAP_INVCSR;
  412. X        return(0);
  413. X    }
  414. X
  415. X    t = tmp->next;
  416. X
  417. X    if (t->hda != NULL)
  418. X    {
  419. X        DEBUG(128, (fprintf(stderr,
  420. X            "ora_dropcursor: freeing hda at %#lx\n", (long) t->hda)));
  421. X        free(t->hda);
  422. X    }
  423. X    if (t->data != NULL)
  424. X    {
  425. X        DEBUG(128, (fputs("ora_dropcursor: freeing data\n", stderr)));
  426. X        ora_free_data(t);
  427. X    }
  428. X
  429. X    DEBUG(128, (fprintf(stderr,
  430. X        "ora_dropcursor: freeing csr at %#lx\n", (long) t->csr)));
  431. X    free(t->csr);
  432. X
  433. X    t = t->next;
  434. X    DEBUG(128, (fprintf(stderr,
  435. X        "ora_dropcursor: freeing cursor at %#lx\n", (long) tmp->next)));
  436. X    free(tmp->next);
  437. X    tmp->next = t;
  438. X
  439. X    DEBUG(8, (fputs("ora_dropcursor: returning\n", stderr)));
  440. X    return(1);
  441. X}
  442. X
  443. X
  444. X/* ora_droplda()
  445. X *
  446. X * This is just here for completeness' sake.
  447. X * (I suppose we could check the value of hda in dropcursor and droplda
  448. X * but I don't think it's worth it
  449. X */
  450. X
  451. Xint ora_droplda(lda)
  452. Xstruct cursor *lda;
  453. X{
  454. X    DEBUG(8, (fprintf(stderr,
  455. X        "ora_droplda(%#lx): calling ora_dropcursor\n", lda)));
  456. X    return(ora_dropcursor(lda));
  457. X}
  458. X
  459. X
  460. X/* ora_findcursor()
  461. X *
  462. X * Checks whether the specified csr is present in the list
  463. X */
  464. X
  465. Xint ora_findcursor(csr)
  466. Xstruct cursor *csr;
  467. X{
  468. X    struct cursor *tmp;
  469. X
  470. X    tmp = &csr_list;
  471. X
  472. X    DEBUG(8, (fprintf(stderr, "ora_findcursor(%#lx)\n", (long) csr)));
  473. X
  474. X    while ((tmp->next != NULL) && (tmp->next != csr))
  475. X    {
  476. X        tmp = tmp->next;
  477. X    }
  478. X
  479. X    if (tmp->next == NULL)
  480. X    {
  481. X        DEBUG(8, (fputs("ora_findcursor: not valid\n", stderr)));
  482. X        return(0);
  483. X    }
  484. X
  485. X    DEBUG(8, (fputs("ora_findcursor: valid\n", stderr)));
  486. X    return(1);
  487. X}
  488. X
  489. X
  490. X/* check_lda()
  491. X *
  492. X * Checks whether the given address corresponds to a valid lda
  493. X */
  494. X
  495. X int check_lda(lda)
  496. X struct cursor *lda;
  497. X {
  498. X    DEBUG(8, (fprintf(stderr, "check_lda(%#lx)\n", (long) lda)));
  499. X
  500. X    if (ora_findcursor(lda) && (lda->hda != NULL) && (lda->data == NULL))
  501. X    {
  502. X        DEBUG(8, (fputs("check_lda: valid\n", stderr)));
  503. X        return (1);
  504. X    }
  505. X    else
  506. X    {
  507. X        DEBUG(8, (fputs("check_lda: invalid\n", stderr)));
  508. X        return (0);
  509. X    }
  510. X};
  511. X
  512. X
  513. X/* check_csr()
  514. X *
  515. X * Checks whether the given address corresponds to a valid csr
  516. X */
  517. X
  518. X int check_csr(csr)
  519. X struct cursor *csr;
  520. X {
  521. X    DEBUG(8, (fprintf(stderr, "check_csr(%#lx)\n", (long) csr)));
  522. X
  523. X    if (ora_findcursor(csr) && (csr->hda == NULL) && (csr->data != NULL))
  524. X    {
  525. X        DEBUG(8, (fputs("check_csr: valid\n", stderr)));
  526. X        return (1);
  527. X    }
  528. X    else
  529. X    {
  530. X        DEBUG(8, (fputs("check_csr: invalid\n", stderr)));
  531. X        return (0);
  532. X    }
  533. X};
  534. SHAR_EOF
  535. chmod 0644 getcursor.c ||
  536. echo 'restore of getcursor.c failed'
  537. Wc_c="`wc -c < 'getcursor.c'`"
  538. test 5749 -eq "$Wc_c" ||
  539.     echo 'getcursor.c: original size 5749, current size' "$Wc_c"
  540. fi
  541. # ============= oracle.mus ==============
  542. if test -f 'oracle.mus' -a X"$1" != X"-c"; then
  543.     echo 'x - skipping oracle.mus (File already exists)'
  544. else
  545. echo 'x - extracting oracle.mus (Text)'
  546. sed 's/^X//' << 'SHAR_EOF' > 'oracle.mus' &&
  547. X/* oracle.mus
  548. X *
  549. X * User subroutine interface to Oracle functions
  550. X */
  551. X/* Copyright 1991 Kevin Stock.
  552. X *
  553. X * You may copy this under the terms of the GNU General Public License,
  554. X * a copy of which should have accompanied your Perl kit.
  555. X */
  556. X
  557. X#include "EXTERN.h"
  558. X#include "perl.h"
  559. X#include "orafns.h"
  560. X
  561. X
  562. Xstatic enum uservars {
  563. X#ifdef    DEBUGGING
  564. X    UV_ora_debug,
  565. X#endif
  566. X    UV_ora_errno,
  567. X    UV_ora_errstr,
  568. X};
  569. X
  570. Xstatic enum usersubs {
  571. X    US_ora_login,
  572. X    US_ora_open,
  573. X    US_ora_fetch,
  574. X    US_ora_close,
  575. X    US_ora_logoff,
  576. X};
  577. X
  578. Xstatic int usersub();
  579. Xstatic int userset();
  580. Xstatic int userval();
  581. X
  582. Xint
  583. Xinit_oracle()
  584. X{
  585. X    struct ufuncs uf;
  586. X    char *filename = "oracle.c";
  587. X
  588. X    uf.uf_set = userset;
  589. X    uf.uf_val = userval;
  590. X
  591. X#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
  592. X
  593. X#ifdef    DEBUGGING
  594. X    MAGICVAR("ora_debug",    UV_ora_debug);
  595. X#endif
  596. X    MAGICVAR("ora_errno",    UV_ora_errno);
  597. X    MAGICVAR("ora_errstr",    UV_ora_errstr);
  598. X
  599. X    make_usub("ora_login",    US_ora_login,    usersub, filename);
  600. X    make_usub("ora_open",    US_ora_open,    usersub, filename);
  601. X    make_usub("ora_fetch",    US_ora_fetch,    usersub, filename);
  602. X    make_usub("ora_close",    US_ora_close,    usersub, filename);
  603. X    make_usub("ora_logoff",    US_ora_logoff,    usersub, filename);
  604. X};
  605. X
  606. X
  607. Xstatic int
  608. Xusersub(ix, sp, items)
  609. Xint ix;
  610. Xregister int sp;
  611. Xregister int items;
  612. X{
  613. X    STR **st = stack->ary_array + sp;
  614. X    register int i;
  615. X    register char *tmps;
  616. X    register STR *Str;        /* used in str_get and str_gnum macros */
  617. X
  618. X    switch (ix) {
  619. X
  620. XCASE    char *    ora_login
  621. XI    char *    database
  622. XI    char *    name
  623. XI    char *    password
  624. XEND
  625. X
  626. XCASE    char *    ora_open
  627. XI    char *    lda
  628. XI    char *    stmt
  629. XEND
  630. X
  631. X    case US_ora_fetch:
  632. X    if (items != 1)
  633. X        fatal("Usage: @array = &ora_fetch($csr)");
  634. X    else {
  635. X        char *csr        = (char *) str_get(st[1]);
  636. X
  637. X        if (curcsv->wantarray) {    /* in array context, return the data */
  638. X        int  retval;
  639. X        char *tmps;
  640. X
  641. X        retval = ora_fetch(csr);
  642. X        astore(stack, sp + retval, Nullstr);
  643. X        st = stack->ary_array + sp;
  644. X        for (i = 0 ; i < retval ; i++) {
  645. X            tmps = ora_result[i];
  646. X            st[i] = str_2mortal(str_make(tmps, strlen(tmps)));
  647. X        }
  648. X        return sp + retval - 1;
  649. X        } else {    /* in scalar context, return the number of fields */
  650. X        struct cursor *csrp;
  651. X        extern int check_csr();
  652. X
  653. X        csrp = (struct cursor *) strtol(csr, (char *) NULL, 0);
  654. X        if (check_csr(csrp))
  655. X            str_numset(st[0], (double) csrp->nfields);
  656. X        else
  657. X            str_set(st[0], (char *) NULL);
  658. X        return sp;
  659. X        }
  660. X    }
  661. X    /* NOTREACHED */
  662. X
  663. XCASE    char *    ora_close
  664. XI    char *    csr
  665. XEND
  666. X
  667. XCASE    char *    ora_logoff
  668. XI    char *    lda
  669. XEND
  670. X
  671. X    default:
  672. X    fatal("Unimplemented user-defined subroutine");
  673. X    }
  674. X    return sp;
  675. X}
  676. X
  677. X
  678. Xstatic int
  679. Xuserset(ix, str)
  680. Xint ix;
  681. XSTR *str;
  682. X{
  683. X    switch (ix) {
  684. X#ifdef    DEBUGGING
  685. X    case UV_ora_debug:
  686. X    ora_debug = (int)str_gnum(str);
  687. X    break;
  688. X#endif
  689. X
  690. X    case UV_ora_errno:
  691. X    fatal("ora_errno is read-only");
  692. X    break;
  693. X
  694. X    case UV_ora_errstr:
  695. X    fatal("ora_errstr is read-only");
  696. X    break;
  697. X    }
  698. X    return 0;
  699. X}
  700. X
  701. X
  702. Xstatic int
  703. Xuserval(ix, str)
  704. Xint ix;
  705. XSTR *str;
  706. X{
  707. X    switch (ix) {
  708. X#ifdef    DEBUGGING
  709. X    case UV_ora_debug:
  710. X    str_numset(str, (double) ora_debug);
  711. X    break;
  712. X#endif
  713. X
  714. X    case UV_ora_errno:
  715. X    str_numset(str, (double) ora_errno);
  716. X    break;
  717. X
  718. X    case UV_ora_errstr:
  719. X    {
  720. X        int len;
  721. X        char ertxt[132];
  722. X
  723. X        if (ora_errno < ORAP_ERRMIN)
  724. X        {
  725. X            oermsg(ora_errno, ertxt);
  726. X            if (ertxt[len = (strlen(ertxt) - 1)] == '\n')
  727. X            {
  728. X                ertxt[len] = '\0';
  729. X            }
  730. X            str_set(str, ertxt);
  731. X        }
  732. X        else
  733. X        {
  734. X            switch (ora_errno)
  735. X            {
  736. X            case ORAP_NOMEM:
  737. X                str_set(str, "insufficient memory");
  738. X                break;
  739. X
  740. X            case ORAP_INVCSR:
  741. X                str_set(str, "invalid cursor");
  742. X                break;
  743. X
  744. X            case ORAP_INVLDA:
  745. X                str_set(str, "invalid login data area");
  746. X                break;
  747. X
  748. X            case ORAP_NOSID:
  749. X                str_set(str, "couldn't set ORACLE_SID");
  750. X                break;
  751. X
  752. X            default:
  753. X                {
  754. X                char tmp[30];
  755. X
  756. X                sprintf(tmp, "unknown oraperl error %d",
  757. X                    ora_errno);
  758. X                str_set(str, tmp);
  759. X                }
  760. X            }
  761. X        }
  762. X    }
  763. X    break;
  764. X    }
  765. X    return 0;
  766. X}
  767. SHAR_EOF
  768. chmod 0644 oracle.mus ||
  769. echo 'restore of oracle.mus failed'
  770. Wc_c="`wc -c < 'oracle.mus'`"
  771. test 3876 -eq "$Wc_c" ||
  772.     echo 'oracle.mus: original size 3876, current size' "$Wc_c"
  773. fi
  774. # ============= orafns.c ==============
  775. if test -f 'orafns.c' -a X"$1" != X"-c"; then
  776.     echo 'x - skipping orafns.c (File already exists)'
  777. else
  778. echo 'x - extracting orafns.c (Text)'
  779. sed 's/^X//' << 'SHAR_EOF' > 'orafns.c' &&
  780. X/* orafns.c
  781. X *
  782. X * Simple C interface to Oracle, intended to be linked to Perl.
  783. X */
  784. X/* Copyright 1991 Kevin Stock.
  785. X *
  786. X * You may copy this under the terms of the GNU General Public License,
  787. X * a copy of which should have accompanied your Perl kit.
  788. X */
  789. X
  790. X#include    "INTERN.h"
  791. X#include    <stdio.h>
  792. X#include    <ctype.h>
  793. X#include    "orafns.h"
  794. X
  795. X
  796. X/* address[] is used to return cursor addresses to the perl program
  797. X * it is used so that we can get the addresses exactly right, without
  798. X * worrying about rounding errors or playing with oracle.mus
  799. X */
  800. X
  801. Xchar    address[20];
  802. X
  803. X
  804. X/* NOSID is returned by set_sid if the environment can't be set */
  805. X
  806. X#define        NOSID    ((char *) -1)
  807. X
  808. X
  809. X/* set_sid(database)
  810. X *
  811. X * Sets the environment variable ORACLE_SID to the given string.
  812. X * Returns the previous value.
  813. X * If the parameter is NULL, restores the previous saved value, if any.
  814. X */
  815. X
  816. Xchar *set_sid(database)
  817. Xchar *database;
  818. X{
  819. X    char        *sid;
  820. X    static    char    *oldsid = NULL,
  821. X            *newsid = NULL;
  822. X
  823. X    DEBUG(8, (fprintf(stderr, "set_sid(%s)\n",
  824. X        (database == NULL) ? "<NULL>" : database)));
  825. X
  826. X    if (database != NULL)
  827. X    {
  828. X        /* normal case - save old value and set new */
  829. X
  830. X        if ((sid = getenv("ORACLE_SID")) != NULL)
  831. X        {
  832. X            if  (oldsid != NULL)
  833. X            {
  834. X                DEBUG(128, (fprintf(stderr,
  835. X                    "set_sid: freeing oldsid (%#lx)\n",
  836. X                    (long) oldsid)));
  837. X                free(oldsid);
  838. X            }
  839. X            if ((oldsid = malloc(strlen(sid) + 1)) == NULL)
  840. X            {
  841. X                DEBUG(128, (fputs("set_sid: out of memory\n",
  842. X                    stderr)));
  843. X                DEBUG(8, (fputs("set_sid: returning NOSID\n",
  844. X                    stderr)));
  845. X                ora_errno = ORAP_NOMEM;
  846. X                return(NOSID);
  847. X            }
  848. X            DEBUG(128, (fprintf(stderr,
  849. X                "set_sid: got oldsid at %#lx\n", (long) oldsid)));
  850. X            strcpy(oldsid, sid);
  851. X        }
  852. X
  853. X        if (newsid != NULL)
  854. X        {
  855. X            DEBUG(128, (fprintf(stderr,
  856. X                "set_sid: freeing newsid (%#lx)\n",
  857. X                (long) newsid)));
  858. X            free(newsid);
  859. X        }
  860. X        if ((newsid = malloc(strlen(database) + 12)) == NULL)
  861. X        {
  862. X            DEBUG(128, (fputs("set_sid: out of memory\n", stderr)));
  863. X            DEBUG(8, (fputs("set_sid: returning NOSID\n", stderr)));
  864. X            ora_errno = ORAP_NOMEM;
  865. X            return(NOSID);
  866. X        }
  867. X        DEBUG(128, (fprintf(stderr,
  868. X            "set_sid: got newsid at %#lx\n", (long) newsid)));
  869. X        strcpy(newsid, "ORACLE_SID=");
  870. X        strcat(newsid, database);
  871. X
  872. X        DEBUG(8, (fprintf(stderr, "set_sid: setting %s\n", newsid)));
  873. X        return (putenv(newsid)) ? oldsid : NULL;
  874. X    }
  875. X    else
  876. X    {
  877. X        if (oldsid == NULL)
  878. X        {
  879. X            DEBUG(8, (fputs("set_sid: oldsid not set\n", stderr)));
  880. X            return(NULL);
  881. X        }
  882. X
  883. X        if (newsid != NULL)
  884. X        {
  885. X            DEBUG(128, (fprintf(stderr,
  886. X                "set_sid: freeing newsid (%#lx)\n", (long)newsid)));
  887. X            free(newsid);
  888. X        }
  889. X        if ((newsid = malloc(strlen(oldsid) + 12)) == NULL)
  890. X        {
  891. X            DEBUG(128, (fputs("set_sid: out of memory\n", stderr)));
  892. X            DEBUG(8, (fputs("set_sid: returning NOSID\n", stderr)));
  893. X            ora_errno = ORAP_NOMEM;
  894. X            return(NOSID);
  895. X        }
  896. X        DEBUG(128, (fprintf(stderr,
  897. X            "set_sid: got newsid at %#lx\n", (long) newsid)));
  898. X        strcpy(newsid, "ORACLE_SID=");
  899. X        strcat(newsid, oldsid);
  900. X
  901. X        DEBUG(8, (fprintf(stderr, "set_sid: setting %s\n", newsid)));
  902. X        return (putenv(newsid)) ? oldsid : NULL;
  903. X    }
  904. X
  905. X    /* NOTREACHED */
  906. X}
  907. X
  908. X
  909. X/* ora_login(database, name, password)
  910. X *
  911. X * logs into the current database under the given name and password.
  912. X */
  913. X
  914. Xchar *ora_login(database, name, password)
  915. Xchar *database, *name, *password;
  916. X{
  917. X    int logged;
  918. X    char *tmp;
  919. X    struct cursor *lda;
  920. X
  921. X    DEBUG(8, (fprintf(stderr,
  922. X        "ora_login(%s, %s, %s)\n", database, name, password)));
  923. X
  924. X    if ((lda = ora_getlda()) == NULL)
  925. X    {
  926. X        DEBUG(8, (fputs("ora_login: couldn't get an lda\n", stderr)));
  927. X        return(NULL);
  928. X    }
  929. X
  930. X    if (set_sid(database) == NOSID)
  931. X    {
  932. X        DEBUG(8, (fputs("ora_login: couldn't set database\n", stderr)));
  933. X        ora_dropcursor(lda);
  934. X        return(NULL);
  935. X    }
  936. X    else if (strcmp(database, getenv("ORACLE_SID")) != 0)
  937. X    {
  938. X        DEBUG(8, (fprintf(stderr,"ora_login: ORACLE_SID misset to %s\n",
  939. X            (tmp = getenv("ORACLE_SID")) ? tmp : NULL)));
  940. X        ora_dropcursor(lda);
  941. X        ora_errno = ORAP_NOSID;
  942. X        return(NULL);
  943. X    }
  944. X
  945. X    logged = orlon(lda->csr, lda->hda, name, -1, password, -1, 0);
  946. X    set_sid(NULL);        /* don't really care if this fails */
  947. X
  948. X    if (logged == 0)
  949. X    {
  950. X        sprintf(address, "%#lx", (long) lda);
  951. X        DEBUG(8, (fprintf(stderr,
  952. X            "ora_login: returning lda %s\n", address)));
  953. X        ora_errno = 0;
  954. X        return(address);
  955. X    }
  956. X    else
  957. X    {
  958. X        ora_errno = lda->csr->csrrc;
  959. X        ora_droplda(lda);
  960. X        DEBUG(8, (fprintf(stderr,
  961. X            "ora_login: failed (error %d)\n", ora_errno)));
  962. X        return((char *) NULL);
  963. X    }
  964. X}
  965. X
  966. X
  967. X/* ora_open(lda, query)
  968. X *
  969. X * sets and executes the specified sql query
  970. X */
  971. X
  972. Xchar *ora_open(lda_s, query)
  973. Xchar *lda_s;
  974. Xchar *query;
  975. X{
  976. X    int i;
  977. X    struct cursor *csr;
  978. X    struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0);
  979. X    short dbsize;
  980. X
  981. X    DEBUG(8, (fprintf(stderr, "ora_open(%#lx, %s)\n", (long) lda, query)));
  982. X
  983. X    if (check_lda(lda) == 0)
  984. X    {
  985. X        DEBUG(8, (fputs("ora_open: returning NULL\n", stderr)));
  986. X        ora_errno = ORAP_INVLDA;
  987. X        return((char *) NULL);
  988. X    }
  989. X
  990. X    if ((csr = ora_getcursor()) == NULL)
  991. X    {
  992. X        /* ora_errno is set by ora_getcursor */
  993. X        DEBUG(8, (fprintf(stderr, "ora_open: can't get a cursor\n")));
  994. X        return((char *) NULL);
  995. X    }
  996. X
  997. X    if ((oopen(csr->csr, lda->csr, (char *)-1, -1, -1, (char *)-1, -1) != 0)
  998. X        || (osql3(csr->csr, query, -1) != 0)
  999. X        || (oexec(csr->csr) != 0))
  1000. X    {
  1001. X        ora_errno = csr->csr->csrrc;
  1002. X        ora_dropcursor(csr);
  1003. X        DEBUG(8, (fprintf(stderr,
  1004. X            "couldn't run SQL statement (error %d)\n", ora_errno)));
  1005. X        return((char *) NULL);
  1006. X    }
  1007. X
  1008. X    /* set up csr->data to receive the information when we do a fetch */
  1009. X
  1010. X    i = 0;
  1011. X    do
  1012. X    {
  1013. X        odsc(csr->csr, ++i, (short *) 0, (short *) 0, (short *) 0,
  1014. X            (short *) 0, (char *) 0, (short *) 0, (short *) 0);
  1015. X    } while (csr->csr->csrrc == 0);
  1016. X    --i;
  1017. X
  1018. X    ora_errno = 0;
  1019. X
  1020. X    if ((csr->data = (char **) malloc(i * sizeof(char *))) == NULL)
  1021. X    {
  1022. X        DEBUG(128, (fputs("ora_open: out of memory\n", stderr)));
  1023. X        DEBUG(8, (fputs("ora_open: returning NOMEM\n", stderr)));
  1024. X        ora_errno = ORAP_NOMEM;
  1025. X        ora_dropcursor(csr);
  1026. X        return(0);
  1027. X    }
  1028. X    DEBUG(128, (fprintf(stderr, "ora_open: got data at %#lx\n",csr->data)));
  1029. X    csr->nfields = i;
  1030. X
  1031. X    for (i = 0 ; i < csr->nfields ; i++)
  1032. X    {
  1033. X        odsc(csr->csr, i + 1, &dbsize, (short *) 0, (short *) 0,
  1034. X            (short *) 0, (char *) 0, (short *) 0, (short *) 0);
  1035. X
  1036. X        if ((csr->data[i] = (char *) malloc(dbsize + 1)) == NULL)
  1037. X        {
  1038. X            csr->nfields = i;
  1039. X            ora_dropcursor(csr);
  1040. X
  1041. X            DEBUG(128, (fputs("ora_open: out of memory\n",stderr)));
  1042. X            DEBUG(8, (fputs("ora_open: returning NOMEM\n",stderr)));
  1043. X            ora_errno = ORAP_NOMEM;
  1044. X            return((char *) NULL);
  1045. X        }
  1046. X        DEBUG(128, (fprintf(stderr, "ora_open: got field %d at %#lx\n",
  1047. X            i, csr->data[i])));
  1048. X        odefin(csr->csr, i + 1, csr->data[i], dbsize + 1, 5, 0,
  1049. X            (short *) 0, (char *) 0, 0, 0, (short *) 0, (char *) 0);
  1050. X    }
  1051. X
  1052. X    sprintf(address, "%#lx", (long) csr);
  1053. X    DEBUG(8, (fprintf(stderr, "ora_open: returning csr %s\n", address)));
  1054. X    return(address);
  1055. X}
  1056. X
  1057. X
  1058. X/* ora_fetch(csr)
  1059. X *
  1060. X * returns the next set of data from the cursor
  1061. X */
  1062. X
  1063. Xint ora_fetch(csr_s)
  1064. Xchar *csr_s;
  1065. X{
  1066. X    struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
  1067. X
  1068. X    DEBUG(8, (fprintf(stderr, "ora_fetch(%#lx)\n", (long) csr)));
  1069. X
  1070. X    if (check_csr(csr) == 0)
  1071. X    {
  1072. X        DEBUG(8, (fputs("ora_fetch: returning NULL\n", stderr)));
  1073. X        ora_errno = ORAP_INVCSR;
  1074. X        return(NULL);
  1075. X    }
  1076. X
  1077. X    if ((csr->nfields == 0) || (ofetch(csr->csr) != 0))
  1078. X    {
  1079. X        DEBUG(8, (fputs("ora_fetch: ofetch failed, returing 0\n",
  1080. X            stderr)));
  1081. X        ora_result = NULL;
  1082. X        ora_errno = csr->csr->csrrc;
  1083. X        return(0);
  1084. X    }
  1085. X
  1086. X    ora_result = csr->data;
  1087. X    ora_errno = 0;
  1088. X    DEBUG(8, (fprintf(stderr,"ora_fetch: returning <%d>\n", csr->nfields)));
  1089. X    return(csr->nfields);
  1090. X}
  1091. X
  1092. X
  1093. Xchar    *OK    = "OK";        /* valid return from ora_close, ora_logoff */
  1094. X
  1095. X/* ora_close(csr)
  1096. X *
  1097. X * Closes an oracle statement, releasing resources
  1098. X */
  1099. X
  1100. Xchar *ora_close(csr_s)
  1101. Xchar *csr_s;
  1102. X{
  1103. X    struct cursor *csr = (struct cursor *) strtol(csr_s, (char **) NULL, 0);
  1104. X
  1105. X    DEBUG(8, (fprintf(stderr, "ora_close(%#lx)\n", (long) csr)));
  1106. X
  1107. X    if (check_csr(csr) == 0)
  1108. X    {
  1109. X        DEBUG(8, (fputs("ora_close: returning NULL\n", stderr)));
  1110. X        ora_errno = ORAP_INVCSR;
  1111. X        return(NULL);
  1112. X    }
  1113. X
  1114. X    oclose(csr->csr);
  1115. X    ora_errno = csr->csr->csrrc;
  1116. X    ora_dropcursor(csr);
  1117. X
  1118. X    DEBUG(8, (fputs("ora_close: returning OK\n", stderr)));
  1119. X    return(OK);
  1120. X}
  1121. X
  1122. X
  1123. X/* ora_logoff(lda)
  1124. X *
  1125. X * Logs the user off of Oracle, releasing all resources
  1126. X */
  1127. X
  1128. Xchar *ora_logoff(lda_s)
  1129. Xchar *lda_s;
  1130. X{
  1131. X    struct cursor *lda = (struct cursor *) strtol(lda_s, (char **) NULL, 0);
  1132. X
  1133. X    DEBUG(8, (fprintf(stderr, "ora_logoff(%#lx)\n", (long) lda)));
  1134. X
  1135. X    if (check_lda(lda) == 0)
  1136. X    {
  1137. X        DEBUG(8, (fputs("ora_logoff: returning NULL\n", stderr)));
  1138. X        ora_errno = ORAP_INVLDA;
  1139. X        return(NULL);
  1140. X    }
  1141. X
  1142. X    ologof(lda->csr);
  1143. X    ora_errno = lda->csr->csrrc;
  1144. X    ora_droplda(lda);
  1145. X
  1146. X    DEBUG(8, (fputs("ora_logoff: returning OK\n", stderr)));
  1147. X    return(OK);
  1148. X}
  1149. SHAR_EOF
  1150. chmod 0644 orafns.c ||
  1151. echo 'restore of orafns.c failed'
  1152. Wc_c="`wc -c < 'orafns.c'`"
  1153. test 8596 -eq "$Wc_c" ||
  1154.     echo 'orafns.c: original size 8596, current size' "$Wc_c"
  1155. fi
  1156. # ============= orafns.h ==============
  1157. if test -f 'orafns.h' -a X"$1" != X"-c"; then
  1158.     echo 'x - skipping orafns.h (File already exists)'
  1159. else
  1160. echo 'x - extracting orafns.h (Text)'
  1161. sed 's/^X//' << 'SHAR_EOF' > 'orafns.h' &&
  1162. X/* orafns.h
  1163. X *
  1164. X * Common declarations for the Oraperl functions
  1165. X */
  1166. X/* Copyright 1991 Kevin Stock.
  1167. X *
  1168. X * You may copy this under the terms of the GNU General Public License,
  1169. X * a copy of which should have accompanied your Perl kit.
  1170. X */
  1171. X
  1172. X
  1173. X/* public functions to be called by Perl programs */
  1174. X
  1175. Xchar        *ora_login(),
  1176. X        *ora_open(),
  1177. X        *ora_close(),
  1178. X        *ora_logoff();
  1179. X
  1180. Xint         ora_fetch();
  1181. X
  1182. X
  1183. X/* These functions are internal to the system, not for public consumption */
  1184. X
  1185. Xstruct    cursor    *ora_getcursor(),
  1186. X        *ora_getlda();
  1187. X
  1188. Xint        ora_dropcursor(),
  1189. X        ora_droplda();
  1190. X
  1191. X
  1192. X/* definition of the csrdef structure - taken from the oracle sample program */
  1193. X
  1194. Xstruct csrdef
  1195. X{
  1196. X   short      csrrc;                  /* return code */
  1197. X   short      csrft;                /* function type */
  1198. X   unsigned long  csrrpc;             /* rows processed count */
  1199. X   short      csrpeo;               /* parse error offset */
  1200. X   unsigned char  csrfc;                /* function code */
  1201. X   unsigned char  csrfil;                      /* filler  */
  1202. X   unsigned short csrarc;                /* reserved, private */
  1203. X   unsigned char  csrwrn;                /* warning flags */
  1204. X   unsigned char  csrflg;                  /* error flags */
  1205. X   /*             *** Operating system dependent ***          */
  1206. X   unsigned int   csrcn;                /* cursor number */
  1207. X   struct {                          /* rowid structure */
  1208. X     struct {
  1209. X    unsigned long    tidtrba;       /* rba of first blockof table */
  1210. X    unsigned short    tidpid;         /* partition id of table */
  1211. X    unsigned char    tidtbl;             /* table id of table */
  1212. X    }        ridtid;
  1213. X     unsigned long   ridbrba;                 /* rba of datablock */
  1214. X     unsigned short  ridsqn;          /* sequence number of row in block */
  1215. X     } csrrid;
  1216. X   unsigned int   csrose;              /* os dependent error code */
  1217. X   unsigned char  csrchk;                   /* check byte */
  1218. X   unsigned char  crsfill[26];               /* private, reserved fill */
  1219. X};
  1220. X
  1221. X
  1222. X/* data structure for the pool of cursors */
  1223. X
  1224. Xstruct    cursor
  1225. X{
  1226. X    struct    csrdef    *csr;
  1227. X    char        *hda,        /* used if this cursor is an lda     */
  1228. X            **data;        /* used to receive database contents */
  1229. X    int        nfields;    /* number of fields to retrieve         */
  1230. X    struct    cursor    *next;        /* list pointer                 */
  1231. X};
  1232. X
  1233. X
  1234. X/* functions that we use */
  1235. X
  1236. Xlong    strtol();
  1237. Xchar    *getenv(), *malloc();
  1238. X
  1239. X
  1240. X/* variables accesible to the outside world */
  1241. X
  1242. XEXT    int    ora_debug, ora_errno;
  1243. XEXT    char    **ora_result;
  1244. X
  1245. X
  1246. X/* Debugging calls.
  1247. X *
  1248. X * I've tried to give these some compatibility with Larry's -D flag,
  1249. X * but allowing some flexibility so that we can debug the oracle functions
  1250. X * without debugging perl as well.
  1251. X *
  1252. X * If your uperl.o was built with -DDEBUGGING, you can define PERL_DEBUGGING
  1253. X * and the oraperl debugging will be initialiased from the -D flag. If not,
  1254. X * you can still define DEBUGGING, but you will have to set ora_debug from
  1255. X * within your program.
  1256. X *
  1257. X * At present, the only flags used are:
  1258. X *       8    program execution - report function entry and exit
  1259. X *     128    use of malloc/free
  1260. X */
  1261. X
  1262. X#ifdef    PERL_DEBUGGING
  1263. X#    ifndef    DEBUGGING
  1264. X#        define    DEBUGGING
  1265. X#    endif
  1266. X#endif
  1267. X
  1268. X#ifdef    DEBUGGING
  1269. X#    define    DEBUG(flag, stmt)    { if (ora_debug & flag) { (stmt); } }
  1270. X#    ifdef    PERL_DEBUGGING
  1271. X        extern    int    debug;    /* exists in uperl.o        */
  1272. X#    else
  1273. X        EXT    int    debug;    /* need to create it ourselves    */
  1274. X#    endif
  1275. X#else
  1276. X#    define    DEBUG(flag, stmt)
  1277. X#endif
  1278. X
  1279. X
  1280. X/* error codes for ORAPERL
  1281. X *
  1282. X * These are higher than any possible ORACLE error code,
  1283. X * so that they can be distinguished
  1284. X */
  1285. X
  1286. X#define    ORAP_ERRMIN    100000    /* lowest value allowed for an oraperl error */
  1287. X
  1288. X#define    ORAP_NOMEM    100001    /* out of memory        */
  1289. X#define    ORAP_INVCSR    100002    /* invalid cursor supplied    */
  1290. X#define    ORAP_INVLDA    100003    /* invalid lda supplied        */
  1291. X#define    ORAP_NOSID    100004    /* couldn't set ORACLE_SID    */
  1292. SHAR_EOF
  1293. chmod 0644 orafns.h ||
  1294. echo 'restore of orafns.h failed'
  1295. Wc_c="`wc -c < 'orafns.h'`"
  1296. test 3578 -eq "$Wc_c" ||
  1297.     echo 'orafns.h: original size 3578, current size' "$Wc_c"
  1298. fi
  1299. # ============= oraperl.1 ==============
  1300. if test -f 'oraperl.1' -a X"$1" != X"-c"; then
  1301.     echo 'x - skipping oraperl.1 (File already exists)'
  1302. else
  1303. echo 'x - extracting oraperl.1 (Text)'
  1304. sed 's/^X//' << 'SHAR_EOF' > 'oraperl.1' &&
  1305. X.po 8
  1306. X.TH ORAPERL 1 Oracle/Perl
  1307. X.ad
  1308. X.nh
  1309. X.SH NAME
  1310. Xoraperl \- Perl access to Oracle databases
  1311. X.SH SYNOPSIS
  1312. X.nf
  1313. X$lda = &ora_login($database, $name, $password)
  1314. X$csr = &ora_open($lda, $stmt)
  1315. X&ora_fetch($csr)
  1316. X&ora_close($csr)
  1317. X&ora_logoff($lda)
  1318. X
  1319. X$ora_debug
  1320. X$ora_errno
  1321. X$ora_errstr
  1322. X.fi
  1323. X.SH DESCRIPTION
  1324. X\fBOraperl\fP is a version of \fIPerl\fP
  1325. Xwhich has been extended (through the \fIusersubs\fP feature)
  1326. Xto allow access to \fIOracle\fP databases.
  1327. X.SH Functions
  1328. XAny program wishing to access an \fIOracle\fP database
  1329. Xmust first log in to \fIOracle\fP
  1330. Xusing \fIora_login\fP.
  1331. XThis is called with three parameters, 
  1332. Xthe system ID of the \fIOracle\fP database to be used,
  1333. X(which \fIOracle\fP products expect
  1334. Xin the \fBORACLE_SID\fP environment variable)
  1335. Xand the \fIOracle\fP username and password.
  1336. XThe return value is a login identifier
  1337. X(an \fIORACLE Login Data Area\fP).
  1338. X
  1339. XTo specify the \fISQL\fP statement to be executed,
  1340. Xthe program must call \fIora_open\fP.
  1341. XThis function takes two parameters:
  1342. Xa login identifier (obtained from \fIora_login\fP)
  1343. Xand the \fISQL\fP statement to be executed.
  1344. XThe return value is a statement identifier
  1345. X(an \fIORACLE cursor\fP).
  1346. X
  1347. XTo retrieve the data returned from an \fISQL\fP \fBSELECT\fP statement,
  1348. Xthe program should make successive calls to \fIora_fetch\fP.
  1349. XThis function takes a single parameter,
  1350. Xa statement identifier (obtained from \fIora_open\fP).
  1351. XIn an array context,
  1352. Xthe return value is an array containing the data,
  1353. Xone element per field.
  1354. XIn a scalar context,
  1355. Xthe return value is the number of fields available from the query.
  1356. X
  1357. XWhen all the data desired has been returned from an \fISQL\fP statement,
  1358. Xthe statement identifier should be released using the \fIora_close\fP function.
  1359. XEvery \fIora_open\fP call should have a corresponding \fIora_close\fP,
  1360. Xeven if it did not return any data.
  1361. XThis function returns the string \fBOK\fP.
  1362. X
  1363. XWhen the program no longer needs to access a given database,
  1364. Xthe login identifier should be released using the \fIora_logoff\fP function.
  1365. XThis function returns the string \fBOK\fP.
  1366. X
  1367. XAll functions return a null string to indicate failure.
  1368. XIn the case of \fIora_fetch\fP, this implies the end of the data.
  1369. X.SH Variables
  1370. XTwo special variables are provided,
  1371. X\fIora_errno\fP and \fIora_errstr\fP.
  1372. XThese may only be read;
  1373. Xa fatal error occurs if a program attempts to change them.
  1374. X\fIOra_errno\fP contains the \fIOracle\fP error code
  1375. Xfrom the last function call, and
  1376. X\fIora_errstr\fP contains the \fIOracle\fP error message
  1377. Xcorresponding to the current value of \fIora_errno\fP.
  1378. X.ne 28
  1379. X.SH EXAMPLE
  1380. X.if t .ft C
  1381. X.ta 4 8 12 16 20 24 28 32 36 40
  1382. X.nf
  1383. X.cc ^        .\" because ex.pl has lines beginning with a .
  1384. X^eo        .\" so that \n etc don't get messed up
  1385. Xformat top =
  1386. X       Name                           Phone
  1387. X       ====                           =====
  1388. X.
  1389. X
  1390. Xformat STDOUT =
  1391. X       @<<<<<<<<<<              @>>>>>>>>>>
  1392. X       $name,                   $phone
  1393. X.
  1394. X
  1395. Xdie ("You should use oraperl, not perl\n") unless defined &ora_login;
  1396. X
  1397. X$lda = &ora_login("t", "name", "password")
  1398. X    || die $ora_errstr;
  1399. X$csr = &ora_open($lda, "select * from telno order by name")
  1400. X    || die $ora_errstr;
  1401. X
  1402. X$nfields = &ora_fetch($csr);
  1403. Xprint "Query will return $nfields fields\n\n";
  1404. X
  1405. Xwhile (($name, $phone) = &ora_fetch($csr))
  1406. X{
  1407. X    write;
  1408. X}
  1409. X
  1410. Xdo ora_close($csr) || die "can't close cursor";
  1411. Xdo ora_logoff($lda) || die "can't log off Oracle";
  1412. X^cc
  1413. X.ec
  1414. X.fi
  1415. X.if t .ft P
  1416. X.SH DEBUGGING
  1417. XIf debugging has been compiled into \fIOraperl\fP,
  1418. Xa further variable, \fIora_debug\fP is available.
  1419. XSetting this variable sets the level of debugging required.
  1420. XIf \fIPerl\fP's own runtime debugging is included,
  1421. Xthis variable is initialised from the \fB-D\fP option.
  1422. XIt may be set from within an \fIOraperl\fP script by normal assignment.
  1423. X
  1424. X.ne 6
  1425. XTo determine whether debugging is available,
  1426. Xyou could use something like this:
  1427. X
  1428. X.in +3
  1429. X.if t .ft C
  1430. X.nf
  1431. X.eo
  1432. Xdefined($ora_debug) && print "debugging available\n";
  1433. Xdefined($ora_debug) || print "debugging not available\n";
  1434. X.ec
  1435. X.fi
  1436. X.if t .ft P
  1437. X.in -3
  1438. X
  1439. XAt present, only flags \fB8\fP (program execution)
  1440. Xand \fB128\fP (use of malloc and free)
  1441. Xare supported.
  1442. X.bp
  1443. X.SH NOTES
  1444. XIn keeping with the philosophy of \fIPerl\fP,
  1445. Xthere is no pre-defined limit to the number of simultaneous logins
  1446. Xor SQL statements which may be active,
  1447. Xnor to the number of data fields which may be returned by a query.
  1448. XThe only limits are those imposed by the amount of memory available,
  1449. Xor by \fIOracle\fP.
  1450. X.SH SEE ALSO
  1451. XDocumentation for \fIOracle\fP, \fISQL*Plus\fP and \fIPro*C\fP.
  1452. X.br
  1453. XDocumentation for \fIPerl\fP.
  1454. X.SH AUTHOR
  1455. X\fIORACLE\fP by Oracle Corporation, California.
  1456. X.br
  1457. X\fIPerl\fP by Larry Wall, Jet Propulsion Laboratory, NASA.
  1458. X.br
  1459. X\fIOraperl\fP by Kevin Stock, Encore Computer SA, France.
  1460. SHAR_EOF
  1461. chmod 0644 oraperl.1 ||
  1462. echo 'restore of oraperl.1 failed'
  1463. Wc_c="`wc -c < 'oraperl.1'`"
  1464. test 4711 -eq "$Wc_c" ||
  1465.     echo 'oraperl.1: original size 4711, current size' "$Wc_c"
  1466. fi
  1467. # ============= oraperl.doc ==============
  1468. if test -f 'oraperl.doc' -a X"$1" != X"-c"; then
  1469.     echo 'x - skipping oraperl.doc (File already exists)'
  1470. else
  1471. echo 'x - extracting oraperl.doc (Text)'
  1472. sed 's/^X//' << 'SHAR_EOF' > 'oraperl.doc' &&
  1473. X
  1474. X.ce 2
  1475. X\fBO R A P E R L\fP
  1476. X_____________
  1477. X
  1478. X
  1479. XThis document describes the implementation of \fBOraperl\fP,
  1480. Xan extension of the \fIPerl\fP language
  1481. Xcapable of accessing \fIOracle\fP databases.
  1482. X
  1483. X\fIPerl\fP provides a facility known as \fIusersubs\fP,
  1484. Xwhich allows user\-specified subroutines
  1485. Xto be linked into a \fIPerl\fP interpreter.
  1486. X\fIOracle\fP provides \fIOCI\fP, the \fIOracle Call Interface\fP,
  1487. Xwhich is a library of subroutines which may be called from C programs.
  1488. X\fBOraperl\fP is a combination of these two features.
  1489. X
  1490. X
  1491. X.ce 2
  1492. X\fBInterface\fP
  1493. X_________
  1494. X
  1495. XThe C language interface of the \fIOCI\fP is not particularly friendly.
  1496. XA number of functions accept redundant parameters,
  1497. Xin order to be useful in a wide range of programming languages.
  1498. XThe interface is not really suitable for \fIPerl\fP
  1499. Xbecause it requires fixed addresses to be specified for receipt of data.
  1500. XA new interface was therefore created for \fBOraperl\fP.
  1501. X
  1502. XThe interface follows the idiom of the following five tasks:
  1503. X
  1504. X.in +5
  1505. X.ta .4i 4.4i
  1506. X.nf
  1507. X\fBTask        Interface\fP
  1508. X
  1509. X\fB1\fP    log in to the database    ora_login
  1510. X\fB2\fP    open a stream for an SQL statement    ora_open
  1511. X\fB3\fP    get the data    ora_fetch
  1512. X\fB4\fP    close the stream    ora_close
  1513. X\fB5\fP    log off of the database    ora_logoff
  1514. X.fi
  1515. X.in -5
  1516. X
  1517. XSteps \fB2\fP and \fB3\fP are kept separate
  1518. Xbecause a single query may produce a large amount of data.
  1519. X
  1520. X
  1521. X.ce 2
  1522. X\fBCursors\fP
  1523. X_______
  1524. X
  1525. XThe \fIOCI\fP communicates with the calling process via \fIcursor\fPs. 
  1526. XOne cursor is required for each login (together with a host data area),
  1527. Xand one for each SQL statement executed.
  1528. XTo save the user the task of allocating cursors,
  1529. X\fBOraperl\fP allocates them automatically,
  1530. Xand returns an identifier to the user
  1531. Xto be supplied as a parameter to future function calls.
  1532. X
  1533. XA set of functions (not directly accessible to the user)
  1534. Xdeals with the allocation and release of cursors.
  1535. X
  1536. X
  1537. X.ce 2
  1538. X\fBInformation from the Database\fP
  1539. X_____________________________
  1540. X
  1541. XEach set of data retrieved from the database
  1542. Xis returned to the user as an array.
  1543. XA program may determine the number of fields to be returned
  1544. Xwithout actually accessing any data.
  1545. XThis may be useful
  1546. Xin a program which allows queries to be entered interactively.
  1547. X
  1548. X
  1549. X.ce 2
  1550. X\fBPublic Function Descriptions\fP
  1551. X____________________________
  1552. X
  1553. XReturn values from functions are in the form of strings,
  1554. Xwith a null string being returned for an error.
  1555. X
  1556. X
  1557. X\fBora_login(database, name, password)\fP
  1558. X
  1559. XRequests a cursor
  1560. Xfor use as a \fILogin Data Area\fP (\fIlda\fP)
  1561. Xand then calls \fBOCI\ orlon\fP
  1562. Xto log the user into the given \fIOracle\fP database
  1563. Xunder the name and password specified.
  1564. XIt returns the address of the \fIlda\fP.
  1565. X
  1566. X
  1567. X\fBora_open(lda, stmt)\fP
  1568. X
  1569. XRequests a cursor (\fIcsr\fP)
  1570. Xand calls \fBOCI\ oopen\fP to connect it the the specified \fIlda\fP.
  1571. XIt then calls \fBOCI\ osql3\fP to attach the SQL statement
  1572. Xand \fBOCI\ oexec\fP to instruct \fIOracle\fP to execute it.
  1573. X
  1574. XIf these three steps succeed,
  1575. X\fBora_open\fP then makes successive calls to \fBOCI\ odsc\fP
  1576. Xto determine the number and size of the fields which will be returned.
  1577. XIt allocates memory for these fields within \fIcsr\fP
  1578. Xand attaches them to the cursor using \fBOCI\ odefin\fP.
  1579. XIt returns the address of the \fIcsr\fP.
  1580. X
  1581. X
  1582. X\fBora_fetch(csr)\fP
  1583. X
  1584. XIn an array context,
  1585. Xcalls \fBOCI\ ofetch\fP with the specified \fIcsr\fP
  1586. Xand returns an array with one element for each field returned.
  1587. XIn a scalar context,
  1588. Xreturns the number of fields available from the query.
  1589. X
  1590. X
  1591. X\fBora_close(csr)\fP
  1592. X
  1593. XCalls \fBOCI\ oclose\fP to release the \fIcsr\fP
  1594. Xand then frees the memory allocated to it.
  1595. XThe string \fBOK\fP is returned.
  1596. X
  1597. X
  1598. X\fBora_logoff(lda)\fP
  1599. X
  1600. XCalls \fBOCI\ ologoff\fP to log off of \fIOracle\fP
  1601. Xand then frees the memory allocated to \fIlda\fP.
  1602. XThe string \fBOK\fP is returned.
  1603. X
  1604. X
  1605. X.ce 2
  1606. X\fBPublic Variable Descriptions\fP
  1607. X____________________________
  1608. X
  1609. XThe variables are read\-only,
  1610. Xsince they refer to the status of \fIOracle\fP commands.
  1611. X
  1612. X
  1613. X\fB$ora_errno\fP
  1614. X
  1615. XContains the error number from the last \fBOCI\fP function executed.
  1616. X
  1617. X
  1618. X\fB$ora_errstr\fP
  1619. X
  1620. XContains the error message corresponding to the current value of $errno.
  1621. X
  1622. X
  1623. X.ce 2
  1624. X\fBPrivate Function Descriptions\fP
  1625. X_____________________________
  1626. X
  1627. X
  1628. XFunctions private to \fBOraperl\fP
  1629. Xdeal with the allocation and release of cursors.
  1630. X
  1631. XThe definition of a cursor is extended from the \fIOracle\fP definition
  1632. Xto include an \fIhda\fP (\fIHost Data Area\fP)
  1633. Xand space for the data returned from the database.
  1634. XThus, \fIcsr\fPs and \fIlda\fPs have the same structure internally.
  1635. XAll the cursors are held on a singly\-linked list.
  1636. X
  1637. X
  1638. X\fBora_free_data(csr)\fP
  1639. X
  1640. XReleases the memory space reserved for data for the specified \fIcsr\fP.
  1641. X
  1642. X
  1643. X\fBora_getcursor()\fP
  1644. X
  1645. XAllocates a new cursor and adds it to the list.
  1646. XIt returns the address of the cursor.
  1647. X
  1648. X
  1649. X\fBora_getlda()\fP
  1650. X
  1651. XCalls \fBora_getcursor\fP to allocate a new cursor,
  1652. Xthen allocates the \fIhda\fP
  1653. Xto allow it to be used for logging into \fIOracle\fP.
  1654. XIt returns the address of the cursor.
  1655. X
  1656. X
  1657. X\fBora_dropcursor(csr)\fP
  1658. X
  1659. XReleases the memory associated with the specified cursor,
  1660. Xand removes it from the list.
  1661. XIt returns 1 if the cursor was successfully dropped,
  1662. X0 otherwise.
  1663. X
  1664. X
  1665. X\fBora_droplda(lda)\fP
  1666. X
  1667. XCalls \fBora_dropcursor\fP to release the cursor
  1668. Xand passes back the return value.
  1669. XOnly exists for completeness,
  1670. Xbut could be extended to verify that what it is dropping is an \fIlda\fP.
  1671. X
  1672. X
  1673. X\fBora_findcursor(csr)\fP
  1674. X
  1675. XSearches the list looking for the specified \fIcsr\fP.
  1676. XIt returns 1 if it was found, 0 otherwise.
  1677. X
  1678. X
  1679. X\fBcheck_csr(csr)\fP
  1680. X
  1681. XChecks whether the address supplied corresponds to a valid data cursor
  1682. X(i.e. it exists in the list,
  1683. Xits \fIhda\fP is not allocated,
  1684. Xits \fIdata\fP area is allocated).
  1685. XIt returns 1 for a valid cursor, 0 otherwise.
  1686. X
  1687. X
  1688. X\fBcheck_lda(lda)\fP
  1689. X
  1690. XChecks whether the address supplied corresponds to a valid login cursor
  1691. X(i.e. it exists in the list,
  1692. Xits \fIhda\fP is allocated,
  1693. Xits \fIdata\fP area is not allocated).
  1694. XIt returns 1 for a valid cursor, 0 otherwise.
  1695. X
  1696. X
  1697. X.ce 2
  1698. X\fBDebugging\fP
  1699. X_________
  1700. X
  1701. X\fIPerl\fP includes support for runtime debugging via a \fB\-D\fP option
  1702. Xwhich sets debugging flags.
  1703. X\fIOraperl\fP also allows runtime debugging by a separate but related mechanism.
  1704. X
  1705. XDebugging is flag based.
  1706. XThe following flags have significance for \fIOraperl\fP:
  1707. X
  1708. X.in +5
  1709. X.ta 5
  1710. X.ti -5
  1711. X\ \ 8    \c
  1712. XReports entry and exit to \fIOraperl\fP functions,
  1713. Xincluding internal functions not directly available to \fIOraperl\fP scripts.
  1714. X
  1715. X.ti -5
  1716. X128    \c
  1717. XReports use of \fImalloc\fP and \fIfree\fP
  1718. Xto obtain cursors, login data areas, etc.
  1719. X.in -5
  1720. X
  1721. XDebugging may be enabled in \fIOraperl\fP
  1722. Xby defining either \fBDEBUGGING\fP or \fBPERL_DEBUGGING\fP during compilation.
  1723. X\fBPERL_DEBUGGING\fP may only be used
  1724. Xif \fIPerl\fP was compiled with debugging enabled.
  1725. XIt differs from \fBDEBUGGING\fP in that
  1726. Xit arranges for the \fIOraperl\fP debugging flags to be initialised
  1727. Xfrom the \fB\-D\fP option on the command line,
  1728. Xif given.
  1729. X
  1730. XIf debugging is compiled into \fIOraperl\fP,
  1731. Xthe debugging flags may be accessed or set
  1732. Xvia the variable \fIora_debug\fP.
  1733. XThis variable may be tested to determine whether debugging has been enabled;
  1734. Xfor example:
  1735. X
  1736. X.ti +5
  1737. X\fBdefined($ora_debug)\0||\0warn("oraperl debugging not enabled\en");\fP
  1738. SHAR_EOF
  1739. chmod 0644 oraperl.doc ||
  1740. echo 'restore of oraperl.doc failed'
  1741. Wc_c="`wc -c < 'oraperl.doc'`"
  1742. test 7198 -eq "$Wc_c" ||
  1743.     echo 'oraperl.doc: original size 7198, current size' "$Wc_c"
  1744. fi
  1745. # ============= oraperl.ref ==============
  1746. if test -f 'oraperl.ref' -a X"$1" != X"-c"; then
  1747.     echo 'x - skipping oraperl.ref (File already exists)'
  1748. else
  1749. echo 'x - extracting oraperl.ref (Text)'
  1750. sed 's/^X//' << 'SHAR_EOF' > 'oraperl.ref' &&
  1751. X.\"    Quick reference sheet for OraPerl
  1752. X.\"
  1753. X.nf
  1754. X.\"
  1755. X.ps 10
  1756. X\fBOraperl Quick Reference\fP
  1757. X.ps 8
  1758. X.sp 2
  1759. X.ps 10
  1760. X\fBOraperl Functions\fP
  1761. X.ps 8
  1762. X.in +2m
  1763. X.sp
  1764. X.ti -2m
  1765. X\fB$lda = &ora_login($database, $name, $password)\fP
  1766. XLogs into the specified database with the name and password given.
  1767. XReturns an \fIlda\fP for use with \fIora_open()\fP.
  1768. X.sp
  1769. X.ti -2m
  1770. X\fB$csr = &ora_login($lda, $statement)\fP
  1771. XExecutes the given SQL statement in the database identified by $lda.
  1772. XReturns a \fIcsr\fP for use with \fIora_fetch()\fP.
  1773. X.sp
  1774. X.ti -2m
  1775. X\fB$n = &ora_fetch($csr)\fP
  1776. XReturns the number of fields available from the query.
  1777. X.sp
  1778. X.ti -2m
  1779. X\fB@ary = &ora_fetch($csr)\fP
  1780. XRetrieves the (next) output data from the statement identified by $csr.
  1781. X.sp
  1782. X.ti -2m
  1783. X\fB&ora_close($csr)\fP
  1784. XFinishes the SQL statement identified by $csr.
  1785. X.sp
  1786. X.ti -2m
  1787. X\fB&ora_logoff($lda)\fP
  1788. XLogs out of the database identified by $lda.
  1789. X.ti -2m
  1790. X.sp 2
  1791. X.ps 10
  1792. X\fBOraperl Variables\fP
  1793. X.sp
  1794. X.ps 8
  1795. X.ti -2m
  1796. X\fB$ora_errno\fP  (read only)
  1797. XContains the error code from the last funtion call.
  1798. X.sp
  1799. X.ti -2m
  1800. X\fB$ora_errstr\fP  (read only)
  1801. XContains the error message corresponding to $ora_errno.
  1802. X
  1803. X.ti -2m
  1804. X\fB$ora_debug\fP  (if debugging is enabled)
  1805. XContains the debugging flags for \fIOraperl\fP.
  1806. XMay be set by a program to debug only certain parts of the script.
  1807. XThe following flags are meaningful:
  1808. X.ta 5m
  1809. X\0\08    report function entry and exit
  1810. X128    report use of malloc and free
  1811. SHAR_EOF
  1812. chmod 0644 oraperl.ref ||
  1813. echo 'restore of oraperl.ref failed'
  1814. Wc_c="`wc -c < 'oraperl.ref'`"
  1815. test 1401 -eq "$Wc_c" ||
  1816.     echo 'oraperl.ref: original size 1401, current size' "$Wc_c"
  1817. fi
  1818. # ============= usersub.c ==============
  1819. if test -f 'usersub.c' -a X"$1" != X"-c"; then
  1820.     echo 'x - skipping usersub.c (File already exists)'
  1821. else
  1822. echo 'x - extracting usersub.c (Text)'
  1823. sed 's/^X//' << 'SHAR_EOF' > 'usersub.c' &&
  1824. X/* usersub.c
  1825. X * 
  1826. X * Initialisation for Oraperl.
  1827. X */
  1828. X/* Copyright 1991 Kevin Stock.
  1829. X *
  1830. X * You may copy this under the terms of the GNU General Public License,
  1831. X * a copy of which should have accompanied your Perl kit.
  1832. X */
  1833. X
  1834. X#include "EXTERN.h"
  1835. X#include "perl.h"
  1836. X#include "orafns.h"
  1837. X
  1838. Xint
  1839. Xuserinit()
  1840. X{
  1841. X    init_oracle();
  1842. X
  1843. X#ifdef    DEBUGGING
  1844. X#ifdef    PERL_DEBUGGING
  1845. X    ora_debug = debug;        /* pick up the -D flag */
  1846. X#else
  1847. X    ora_debug = 0;
  1848. X#endif    /* PERL_DEBUGGING */
  1849. X#endif    /* DEBUGGING */
  1850. X
  1851. X    ora_errno = 0;
  1852. X}
  1853. X
  1854. SHAR_EOF
  1855. chmod 0644 usersub.c ||
  1856. echo 'restore of usersub.c failed'
  1857. Wc_c="`wc -c < 'usersub.c'`"
  1858. test 499 -eq "$Wc_c" ||
  1859.     echo 'usersub.c: original size 499, current size' "$Wc_c"
  1860. fi
  1861. exit 0
  1862.  
  1863. exit 0 # Just in case...
  1864. -- 
  1865. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  1866. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  1867. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  1868. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  1869.